home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 3 / Cream of the Crop 3.iso / diag / itcom1.zip / COMPARE.EXE / IT / DEMO / TEST1.CLA < prev    next >
Text File  |  1993-10-08  |  11KB  |  279 lines

  1.                 TITLE('Tester')
  2. OMIT('╝')
  3. ╔════════════════════════════════════════════════════════════════════════════╗
  4. ║  Program - Tester                              !                           ║
  5. ║  Author  - John Doe                            !                           ║
  6. ╚════════════════════════════════════════════════════════════════════════════╝
  7.                  PROGRAM
  8.  
  9.                  INCLUDE('KEYCODES.EQU')
  10.                  INCLUDE('CLARION.EQU')
  11.                  INCLUDE('ERRORS.EQU')
  12.  
  13.                  MAP
  14.                    CheckOpen(*FILE)
  15.                    DiskError(<STRING>),BYTE
  16.                    ShowWarning
  17.                    MODULE('ITCOMP01')
  18.                      Procedure11
  19.                      Procedure12
  20.                      Procedure13
  21.                    END
  22.                    MODULE('ITCOMP02')
  23.                      Procedure21
  24.                      Procedure22
  25.                      Procedure23
  26.                    END
  27.                    MODULE('ITCOMP03')
  28.                      Procedure31
  29.                      Function32(STRING,QUEUE,BYTE),SHORT
  30.                      Procedure33
  31.                      Procedure34
  32.                    END
  33.                    MODULE('ITCOMP04')
  34.                      Function41(FILE,FILE),SHORT
  35.                      Function42(FILE,FILE),SHORT
  36.                    END
  37.                    INCLUDE('C:\CLARION3\INCLUDE.INC')
  38.                    INCLUDE('GETDIR.INC')
  39.  EMBED('~~::PROGRAM~1~MAP Structure~1~~')
  40.                    INCLUDE('TEMPFILE.INC')
  41.  
  42.  ENDEMBED
  43.  
  44.                  END
  45.  
  46.                  EJECT('File Layouts')
  47.  
  48. GLO:MessageGroup GROUP
  49. GLO:Message1       STRING(45)
  50. GLO:Message2       STRING(45)
  51. GLO:Message3       STRING(45)
  52.                  .
  53. GLO:InsertMsg    STRING('Record will be added {9}')
  54. GLO:ChangeMsg    STRING('Record will be changed {7}')
  55. GLO:DeleteMsg    STRING('Select OK to delete {10}')
  56. GLO:Filespec     STRING(64)
  57. dF:Variable1     STRING(64)
  58. dF:Variable2     STRING(64)
  59. dF:Variable3     STRING(64)
  60. df:Variable4     STRING(64)
  61. dF:Variable5     STRING(64)
  62. dF:Variable6     STRING(64)
  63. dF:Variable7     STRING(64)
  64. ExitChain        SHORT
  65. GLO:EnablePrint  BYTE
  66. ! ███████████████████████████████████████████████████████████████████
  67. !  TEST1.CLA
  68. ! ███████████████████████████████████████████████████████████████████
  69.  
  70.  
  71. FileIn           FILE,PRE(In),DRIVER('Ascii'),NAME(dF:AsciiIn)!<<DRIVER
  72. RECORD             RECORD                                     !<<STRUCT
  73. sLine                STRING(255)
  74.                  . .
  75.  
  76. include('TESTINC.INC')            !<<<INCLUDE has FILE SPEC not in TEST2.CLA
  77.  
  78. File1            FILE,PRE(Fi1),DRIVER('Btrieve'),NAME(dF:Variable1) !<<PRE
  79. I_Dyna1            INDEX(),NAME('sams.idx')                    !<<<NAME
  80. I_Dyna2            INDEX(+Fi1:Field1,-Fi1:Field2),OPT          !<<NOCASE
  81. K_Dummy            KEY(+Fi1:Field1,-Fi1:Field2,-Fi1:Field3),DUP!<<Order 2nd
  82. testrecord         RECORD
  83. Field1               STRING(64)
  84. Field2               STRING(16)                                !<<STRING(8)
  85. Field3               LONG
  86. Field4               STRING(8)
  87. Field5               STRING(32)
  88. Field6               STRING(12)
  89. !Field7              BYTE                                      !<<Commented
  90. Field8               BYTE
  91. Field9               BYTE
  92. Field10              STRING(64)
  93. Field11              STRING(3)
  94.                  . .
  95.  
  96. File2            FILE,PRE(Fi2),DRIVER('Clarion'),CREATE,NAME(dF:Variable2)!─┐
  97. I_Dyna1            INDEX(),NOCASE             !<<No CREATE, No Name ─────────┘
  98. I_Dyna2            INDEX(),NOCASE
  99. RECORD             RECORD
  100. Field1               STRING(32)               !<<STRING(16)
  101. Field2               STRING(16)
  102. Field3               LONG
  103. Field4               STRING(8)
  104. Field5               STRING(16)
  105. Field6               STRING(12)               !<<Commented
  106. Field7               BYTE
  107. Field8               BYTE
  108. Field9               BYTE
  109. Field10              STRING(64)
  110. Field11              STRING(3)
  111.                  . .
  112.  
  113. ! <<<<<<<<<<<<<  Omitted File3
  114.  
  115. File4            FILE,PRE(Fi4),DRIVER('Btrieve'),CREATE !<<DRIVER, no NAME
  116. I_Dyna1            INDEX(),NOCASE
  117. I_Dyna2            INDEX(),NOCASE
  118. RECORD             RECORD
  119. Field41              LONG
  120. Field42              LONG
  121. Field43              LONG
  122. Field44              STRING(16)
  123. Field45              STRING(20)
  124. Group41              Group,Pre(G41)                          !<<PRE
  125. GrField41                    STRING(4)
  126. GrField42                    LONG                            !<<LONG
  127.                  . . .
  128.  
  129.  
  130.  
  131. File5            FILE,PRE(Fi5),DRIVER('Clarion'),CREATE,NAME(dF:Variable5)
  132. I_Dyna1            INDEX(),NOCASE
  133. I_Dyna2            INDEX(),NOCASE
  134. RECORD             RECORD
  135. Field51              LONG
  136. Field52              LONG
  137. Field53              LONG
  138. Field54              STRING(16)
  139. Field55              STRING(16)
  140. Field56              SHORT
  141. Field57              STRING(16)
  142. Field58              BYTE
  143.                  . .                                     !No GROUP Group59
  144.  
  145. File6            FILE,PRE(Fi6),DRIVER('Clarion'),CREATE,NAME(dF:Variable6)!─┐
  146. I_Dyna1            INDEX(),NOCASE                 !<<< NO File 6 ────────────┘
  147. I_Dyna2            INDEX(),NOCASE
  148. RECORD             RECORD
  149. Field61              LONG
  150. Field62              LONG
  151. Field63              STRING(16)
  152. Field64              STRING(16)
  153. Field65              BYTE
  154. Field66              BYTE
  155. Field67              BYTE
  156. Field68              STRING(64)
  157.                  . .
  158.  
  159.  
  160. AddRecord        EQUATE(1)                       !  Add a new record
  161. ChangeRecord     EQUATE(2)                       !  Change the current record
  162. DeleteRecord     EQUATE(3)                       !  Delete the current record
  163.  
  164.  EMBED('~~::PROGRAM~1~Data Section~1~~')
  165. Queue              Queue,Pre(Qst)
  166. QPtr                 BYTE
  167. QValue               STRING(32)
  168.                    .
  169.  
  170. n                  LONG
  171. nFormat            STRING(5)
  172. Temp               CSTRING(65)
  173. TmpFile            CSTRING(65)
  174.  ENDEMBED
  175.  
  176.  
  177.   CODE
  178.     Procedure1
  179.   RETURN                                         !Return to DOS
  180.  
  181. OMIT('╝')
  182. ╔════════════════════════════════════════════════════════════════════════════╗
  183. ║  Check ERROR() function after opening a file                               ║
  184. ╚════════════════════════════════════════════════════════════════════════════╝
  185. CheckOpen         PROCEDURE(File)
  186.  
  187.   CODE
  188.   OPEN(File,22h)                                 !Attempt to open the file
  189.   CASE ERRORCODE()                               ! and check for errors
  190.   OF NoError                                     !Return if no error
  191.   OROF IsOpenErr                                 ! or if already open.
  192.     RETURN
  193.   OF NoFileErr                                   !If file was not found
  194.     CREATE(File)                                 !Create the file
  195.     OPEN(File,22h)                               ! then open it
  196.     IF ~ERRORCODE() THEN RETURN.                 !  And return if it opened
  197.   OF InvalidFileErr                              !Invalid Record Declaration
  198.     GLO:Message1 = 'Error accessing: '& NAME(File)
  199.     GLO:Message2 = 'Code: ' & ERRORCODE() & ' ' & ERROR()
  200.     GLO:Message3 = 'Press OK to return to DOS'
  201.     ShowWarning
  202.     HALT(InvalidFileErr)
  203.   OF BadKeyErr                                   !Key Files must be rebuilt
  204.     GLO:Message1 = NAME(File) & ' Key file is invalid'
  205.     GLO:Message3 = 'Press OK to rebuild keyfile'
  206.     ShowWarning
  207.     OPEN(File,12H)                               !Open for exclusive access
  208.     BUILD(File)                                  !Rebuild the key files
  209.     IF ERRORCODE()
  210.       GLO:Message1 = NAME(File) & ' The file cannot be repaired'
  211.       GLO:Message2 = 'while other stations are using it'
  212.       GLO:Message3 = 'Press OK to return to DOS'
  213.       ShowWarning
  214.       HALT(BadKeyErr)
  215.     ELSE
  216.       CLOSE(File)                                !Close
  217.       OPEN(File,22h)                             ! then open it
  218.     END
  219.   END                                            !End of Case Structure
  220.   IF DiskError(NAME(File) & ' File could not be opened') THEN HALT(0). !Cannot resume
  221.  
  222. OMIT('╝')
  223. ╔════════════════════════════════════════════════════════════════════════════╗
  224. ║  Check ERROR() function after a disk access                                ║
  225. ╚════════════════════════════════════════════════════════════════════════════╝
  226. DiskError        FUNCTION(Cause)
  227. StopMsg::        STRING(180)
  228.  
  229.   CODE
  230.   IF ~ERRORCODE() THEN RETURN(0).                !Return with no error
  231.   IF ~OMITTED(1)                                 !If a cause was given
  232.     StopMsg:: = 'Cause: ' & Cause & LF:CR        !  Display it
  233.   END                                            !End IF
  234.   IF ERRORFILE()                                 !If error involves a file
  235.     StopMsg:: = CLIP(StopMsg::) & 'File : '  |   !  display the file
  236.               & ERRORFILE() & LF:CR
  237.   END                                            !End IF
  238.   StopMsg:: = CLIP(StopMsg::) & 'Error: '    |   !Display the error code
  239.             & ERRORCODE() & ' - '            |   !  and the error message
  240.             & ERROR() & LF:CR
  241.  
  242.   STOP(StopMsg::)                                !Stop with message
  243.   RETURN(1)                                      !Return with error
  244.  
  245. OMIT('╝')
  246. ╔════════════════════════════════════════════════════════════════════════════╗
  247. ║  Display a warning message using 3 Global message variables.               ║
  248. ╚════════════════════════════════════════════════════════════════════════════╝
  249. ShowWarning      PROCEDURE
  250.  
  251. SaveStyle        STRING(256)
  252.  
  253. Screen           SCREEN(9,53),PRE(SCR),CENTER,SHADOW,CUA,COLOR(112)
  254.                    ROW(1,1)    STRING('█▀{51}█'),COLOR(116)
  255.                    ROW(9,1)    STRING('█▄{51}█'),COLOR(116)
  256.                                REPEAT(7)
  257.                    ROW(2,1)      STRING('█'),COLOR(116)
  258.                    ROW(2,53)     STRING('█'),COLOR(116)
  259.                                .
  260.                    ROW(3,5)    ENTRY(@S45),USE(GLO:Message1),INS,SKIP,COLOR(112,112,112)
  261.                    ROW(4,5)    ENTRY(@S45),USE(GLO:Message2),INS,SKIP,COLOR(112,112,112)
  262.                    ROW(5,5)    ENTRY(@s45),USE(GLO:Message3),INS,SKIP,COLOR(112,112,112)
  263.                    ROW(7,24)   BUTTON('  &Ok  |'),SHADOW,USE(?Ok),COLOR(23,71,24,31,79)
  264.                  .
  265.  
  266.   CODE
  267.   SaveStyle = STYLES()                           !Save current style
  268.   GETSTYLES('')                                  !Turn off Styles
  269.   GLO:Message1 = CENTER(GLO:Message1,SIZE(GLO:Message1))
  270.   GLO:Message2 = CENTER(GLO:Message2,SIZE(GLO:Message2))
  271.   GLO:Message3 = CENTER(GLO:Message3,SIZE(GLO:Message3))
  272.   OPEN(Screen)
  273.   DISPLAY
  274.   ACCEPT                                         !Enable keyboard and mouse
  275.   CLEAR(GLO:MessageGroup)                        !Blank out message fields
  276.   SETSTYLES(SaveStyle)                           !Restore user styles
  277.   RETURN
  278.  
  279.